perm filename MS.F4[NEW,LCS]17 blob
sn#640324 filedate 1982-02-09 generic text, type T, neo UTF8
C****** MS.F4 *************
COPYRIGHT 1982 BY LELAND SMITH
C ********** DISPLAYS MUSIC AND DRAWS IT ON THE PLOTTER **********
C *** READS DATA FROM CLEFA-B-C-ETC., BDR40,BDI40, ETC.
IMPLICIT INTEGER(A-Q,S-Z)
REAL DIS,DISX,A,B,STFF,CENTR,POS ,UD,XDIS
DIMENSION LST(18),DP(0/7)
COMMON /DL/X22,SAVER,NAME,EXT,IOLD /RRJJ/RJJ2,RJJ(20),JJA
1 /FONT/JFONT /RINP/R(10,80),RPOS(2,50),RI(400)
CC2/82 1 /FONT/JFONT /RINP/R(10,80),RPOS(2,50),RI(200)
C***** 2/82 ***** SEE ALSO 'MOVER' IN CLEFS.F4 FOR ARRAY CHANGE
COMMON /RMOD/RMODE2,RSET4,IBEAM,
3 NOSET,STEM,STUP,NTC,ENDP,RAD,RDD,ITB,POSB
4 /FRMT/F78F(1),FA1(1),FA5(1),ASK /SIZ/RSZ,JCEN,KCEN
C ORDER OF COMMON MUST! REMAIN AS IS (FOR DMP MODE READ)
COMMON /LIMIT/LIMIT,ITEM,L,I,IX,ITEMX,ILIM
1 /STF/RSTFAC(0/7),RSTJ2
2 /POSI/STFF(0/7),JJ2,POS /ALF/INP(72),ML
3 /SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
4 /UPDWN/ RL,UD /IDEV/IDEV,CHNG /NUM/NUM(10),JRD
5 /PLTR/PLT,RHT,DIS,XDIS /PTR/PWDS(400) /DPTR/WDS(400)
COMMON/A2Z/LAA,LBB,LCC,LDD,LEE,LFF,LGG,LHH,LII,LJJ,LKK,LEL,LMM
1 ,LNN,LOH,LPP,LQQ,LRR,LSS,LTT,LUU,LVV,LWW,LXX,LYY,LZZ
2 /JCHAR/IXX,ISEMI,IBLA,IG,JED,KED,REDIT,RITEM
COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) /RNW/RNW /MKS/MKS(14)
1 /XRN/RN(4000) /DPY/ST(4000),MEDIT,IGO
2 /MKX/MKX(11) /SC/SSC(72) /YED/YED,IBOX,RBOX/JCLIP/JCLIP
1 /CHK/ICHK,ITCHK,JIT,SPD,IDPY,M
EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3)),(I4,
1 INP(4)),(R6,RJQ(4)),(J10,JQ(8)),(J6,JQ(4)),(R4,RJQ(2)),(R7,
2 RJQ(5)),(R3,RJQ(1)),(I2,INP(2)),(I1,INP(1)),(I3,INP(3)),
3 (RJ13,RJJ(11))
4,(R11,RJQ(9)),(NJR,R10,RJQ(8)),(R8,RJQ(6)),(RJ3,RJJ(1)),(R9,
5 RJQ(7)),(RX3,RJQ(20)),(ST2,ST(2)),(R13,RJQ(11)),(J8,JQ(6))
6 ,(J13,JQ(11)),(IPOS,POS),(LST(13),K),(LST(14),X),(LST(15),J)
7 ,(I7,INP(7)) ,(ISTAR,MKX(11))
1 ,(MINUS,MKX(10)),(LESS,MKX(3)),(IGT,MKX(4)),(RJ7,RJJ(5))
DATA NUM/'0','1','2','3','4','5','6','7','8','9'/,JRD/0/,ILIM/400/
1 ,STFF/-469.,-346.,-223.,-100.,23.,146.,269.,392./,RSTFAC/8*1./
2 ,LST/'NOTE','REST','CLEF','LINE','SLUR','BEAM','TRILL','STAFF',
3 'MISC','NUMB','LIBRY','CIRCL',0,0,0,'WORD','KSIG','METER'/
4 ,DP/8*1/,RNW/2.44/,LCNT/1/,LIMIT/4000/,DIS/1.0/, RHT/1.0/
5 ,PLUS/'+'/,EXT/'MS '/,COMMA/','/,FILNAM/'INIT'/
DATA MKS/'W','A','F','S','M','T','D','U','H','I','P','C','R','O'/
C THE GIANT NUMBERS ARE FOR [ AND ]
DATA MKX/'/',';','<','>',-19728949184,-18655207360,'(',')','.'
1,'-','*'/,SSC(14)/'X'/,SSC(15)/';'/,SSC(72)/' '/
C LIMIT IS MAIN ARRAY LENGTH (4000) /SC/SSC ARRAY USED IN MARKS,BEAMS,SLURS
C 400 LIM. ON ITEMS PWDS, WDS (SEE ALSO 571 TO 170)(ALSO ILIM IN DATA)
C9765 FORMAT(
C 1' ***** NEW MS. IF PROBLEMS TYPE "R MS.OLD" INSTEAD. ****')
C TYPE 9765
IDEV=5
I1=0
CALL TYPLOC(450,200)
10 CALL DPYX
C THIS DOES DPYSET, ETC.
DO 20 K=1,I
CLEARS ARRAY FOR RESTART OF 'SETUP' ROUTINE
20 RN(K)=0
JFONT=0
CHNG=0
C flag for edit changes (=-1 means a change has been made.)
IOLD=0
C IOLD HOLDS LAST ITEM NUM. EDITED.
IX=0
RSET4=999
QUICK=0
CB=0
C CB IS CENTER-BIG (CENTERING RANGE=6)
UD=1
RL=1
FSCN=LEL
RPOS(1,1)=0
RSZ=.845
JCLIP=525
X22=0
MINUZ=0
C MINUZ IS FLAG FOR '-' SETTING CRLF BACKUP FEATURE (WHEN IN EDIT MODE)
JCEN=0
KCEN=0
PLT=0
PWDS(1)=1
EDQ=-1
RN(2)=0
C FOR RESTART. AVOIDS STAFF CODE NUM.
SAVER=4
DO 30 K=0,7
30 RSTFAC(K)=1.
REDIT=999.
M=1
ITEM=0
ITEMX=0
ZERO=-1
WDS(1)=4
C DATA IN DPY ARRAY STARTS AT WD.4!
I=1
40 SCORE=-1
50 IGO=-1
IF(I1.NE.LRR)GO TO 130
I1=-1
CALL NAMEXT(INP,NAME,EXT)
J2=0
IF(NAME.NE.IBLA)GO TO 2250
C YOU CAN TYPE 'RS NAME' FOR QUICK RESTARTS
GO TO 130
60 CALL NOTWRT
70 IF(M.GT.I)GO TO 80
CC IF(IGO)CALL DPYOUT(1)
C11/80 IF(IGO)CALL DPYDO(1)
IF(IGO)CALL DPYDO(1)
C12/80 IF(IGO.LT.0.AND.X22.EQ.0)CALL DPYDO(1)
C DPYOUT DONE IN 'BOX' IF CURSOR IS TO APPEAR ALSO.
80 ITEM=ITEM+1
IF(ITEM.LT.ILIM)GO TO 90
CALL TYPSTR('**** TOO MANY ITEMS')
CALL TYPINT(ITEM)
CALL TYPSTR('/349')
CALL TYPCRLF
I=PWDS(ILIM)
ITEM=ILIM-1
ST2=WDS(ILIM)
CC CALL DPYOUT(1)
CALL DPYDO(1)
GO TO 40
90 IF(IGO.GT.0)GO TO 100
K=ST2
IF(X22.EQ.0)GO TO 100
CALL BOX(IBOX,RBOX)
ST2=K
100 WDS(ITEM+1)=ST2
IF(EDQ.EQ.-1)GO TO 110
IF(M.LT.I)GO TO 2370
C SL=SAVE AFTER RESETTING LENGTH OF PAGE. (SEE I2 IN SCX)
110 PWDS(ITEM+1)=I
PLT=0
IF(IGO.NE.0)GO TO 120
CC CALL DPYOUT(1)
CALL DPYDO(1)
IF(SCORE.EQ.0)GO TO 1000
C GO GET MORE FROM SCX.
IGO=-1
120 IF(SCORE.EQ.0)GO TO 1070
130 SVST=ST2
C CATCHES TYPO WITH 'C'
K=ITEM+1
IF(X22.EQ.0)GO TO 250
C 'N' SUPPRESSES TYPE-OUT, 'P' OR NEW ITEM RESTORES IT.
IF(QUICK)170,140,290
C -1=QUICK MODE, +1=SUPPRESS TYPE-OUT OF PARAMS, 2=AS 1, BUT RESETS AT C
140 L=RN(MEDIT+1)
K=X22
CXX IF(IDEV.EQ.1)GO TO 250
IF(IDEV.EQ.1)GO TO 290
C 'FILE'CAN BE USED WHILE IN EDIT MODE
CALL TYPCRL
CALL TYPWRD(LST(L))
CALL TYPCRL
CALL TYPFLT(RN(MEDIT+1))
CALL TYPCHR(' ',3)
CALL TYPFLT(RN(MEDIT+2))
CALL TYPCHR(' ',3)
CALL TYPFLT(RN(MEDIT+3))
IF(YED.LT.2)GO TO 260
C YED IS SET AT 426
DO 150 L=4,YED+2
CALL TYPCHR(' (',4)
CALL TYPINT(L)
CALL TYPCHR(') ',2)
150 CALL TYPFLT(RN(MEDIT+L))
CALL TYPCRL
GO TO 260
160 IF(X22.EQ.0)GO TO 260
QUICK=-1
CALL TYPSTR(';=LFT :=RT (=UP )=DN /=HALF *=*2')
CALL TYPCRL
170 CALL FSCAN
C FNUM.FAI=FAST COMMANDS ;=← :=→ (=↑ )= /=HALF *=*2 X=X C=C OTHERS=CR
GO TO 380
GO TO 400
GO TO 410
GO TO 420
GO TO 450
GO TO 470
GO TO 430
GO TO 440
I1=0
180 QUICK=0
GO TO 330
190 FORMAT(2A5)
200 REREAD 190,K,K
IF(I4.NE.LPP)GO TO 210
CALL HELP(K)
GO TO 130
210 CALL LO2UP(K)
C CHANGES LOWER CASE TO UPPER CASE
IF(K.NE.IBLA)GO TO 215
K=FILNAM
CALL TYPSTR('READING ')
CALL TYPWRD(K)
CALL TYPCRL
215 FILNAM=K
C SAVE NAME FOR LATER USE. 'READ' OR 'RR' ALONE READS PREVIOUS FILE.
IF(LOOK(K)+LOOKD(K))GO TO 220
CALL TYPSTR(' FILE NOT FOUND')
GO TO 260
CC2502 CALL IFILE(1,K)
220 CALL FILX(K)
C GOBBLES ET HEADER OR CONVERTS SOS FILE
230 IDEV=1
GO TO 290
240 IDEV=5
GO TO 260
C RESET TO TTY MODE
250 CALL HYDPOG(3)
C TO DELETE VERTICAL LINE (55)
KED=0
QUICK=0
C RESET PARAM TYPE-OUT
RJ13=0
C KILL CENTERING FEATURE FOR NOW
260 IF(IDEV.EQ.1)GO TO 290
CALL TYPCRL
IF(X22.EQ.0)GO TO 270
CALL TYPSTR('**** EDIT ITEM #')
CALL TYPINT(K)
GO TO 280
270 CALL TYPWRD(NAME)
CALL TYPCHR('.',1)
CALL TYPWRD(EXT)
CALL TYPSTR(' TYPE FOR ITEM #')
CALL TYPINT(K)
CALL TYPSTR(' ')
CALL TYPINT(I)
CALL TYPSTR(' ')
CALL TYPINT(SVST)
280 CALL TYPCRL
290 SCORE=-1
CQQ ACCEPT 89,INP
READ(IDEV,700,END=240)INP
IF(I1.EQ.LESS)GO TO 240
C '<' = TEMPORARY ESCAPE FROM 'FILE' MODE
IF(I1.NE.IGT)GO TO 300
C '>' = RETURN TO 'FILE' MODE - IF NOT STILL EDITING.
IF(X22.NE.0)GO TO 260
GO TO 230
300 IF(I1.EQ.':')CALL CMDIN
IF(I1.EQ.ISEMI)CALL CMDIN
C TYPE : AS FIRST ITEM TO SAVE COMMAND LINE. TYPE ; TO REPEAT IT.
CALL LULOOP
IF(IDEV.EQ.5)GO TO 320
IF(I7.NE.LTT)GO TO 320
IF(I1.NE.LCC)GO TO 320
C 'ET' DIRECTORY? UGH!!!
310 READ(IDEV,700)INP
IF(I3.NE.ISEMI)GO TO 310
READ(IDEV,700)INP
C READ AGAIN TO GET PAGE MARK - OR SOMETHING???
GO TO 290
C****320 REREAD 2430,J,R2,RJQ
C ↑↑↑ 1/78
320 CALL READX
CRR J=JA
C FIRST CATCHES BLANKS, NUMBERS, ETC.
330 IF(I1.GT.COMMA)GO TO 900
IF(I1.EQ.IBLA)GO TO 900
IF(I1.EQ.LII)GO TO 740
C I = IN, ITEM
IF(I1.EQ.IXX)GO TO 640
C X = EXIT
IF(I1.EQ.LEL)GO TO 680
C L = LEFT, LP=LIGHT PEN
IF(I1.EQ.LUU)GO TO 680
C U = UP
IF(I1.EQ.LRR)GO TO 660
C R = RIGHT, RI=RIT, READ, RS=RESTART
IF(I1.EQ.LDD)GO TO 360
C D = DOWN, DI=DIM, DE=DELETE
IF(I1.EQ.LCC)GO TO 1740
C C = COPY, CR=CRESC., CN=CENTER, CB=CENTER BIG, CH=ON HEAD, CT=ON TAIL
C CX = UNCENTER CP n =CENTER BY NOTE POSITION CD=CENTER DASHES
IF(I1.EQ.LSS)GO TO 490
C S = SAVE, SPACING STAFF, STAFF, SHOW, SF, SFZ, SCALE, STC=STACCATO
IF(I1.EQ.LEE)GO TO 540
C E ED=EDIT WITH POS. FIRST, E=EDIT WITH LIGHT PEN, ES=EDIT WITH STAFF NUM
IF(I1.EQ.LNN)GO TO 710
C N = NO TYPE, NX = RESET TO NEXT ALPHABETICAL NAMED FILE
IF(I1.EQ.LPP)GO TO 1150
C P = P,PP,PPP, P N=PRINT PARAM N., PR=PRINT PARAM LIST, POCO, PIU, PZ=PIZZ,
IF(I1.EQ.LAA)GO TO 350
C A = ADJUST TO SET, AD=ADJUST STEMS, AC=ACCEL, AR=ARCO, AT=A TEMPO, ACT=ACCENT
IF(I1.EQ.LQQ)GO TO 160
C Q = QUICK
IF(I1.EQ.LTT)GO TO 770
C T = TYPE TEXT, T=TYPE OUT, TE=TENUTO, TL=TYPLOC
IF(I1.EQ.LFF)GO TO 870
C F = F,FF,FFF,FE=FERMATA,FILE(TO READ COMMAND FILE)
IF(I1.EQ.LHH)GO TO 840
C H = HARMONIC, HW=HEAVY WEDGE, HELP
IF(I1.EQ.COMMA)GO TO 1460
C VALUE OF COMMA IS > VALUE OF PLUS
IF(I1.GE.PLUS)GO TO 900
IF(X22.NE.0)GO TO 260
C NEXT CANNOT HAPPEN IN EDIT MODE.
C O = O=ORDER BY STAFF, OX=ORDER WITHOUT REGARD FOR STAFF NUM.
IF(I1.NE.LOH)GO TO 340
C NEXT FOR REORDERING ITEMS FROM LEFT TO RIGHT, BY STAFF. THEN IT DOES A
IF(I2.EQ.LXX)R2=1
CALL ORDER
340 IF(I1.EQ.LZZ)GO TO 1170
C Z = ZOOM
IF(I1.EQ.LMM)GO TO 1770
C M = MOVE, ME=MENO, MO=MOLTO, MF,MP
IF(I1.EQ.LJJ)GO TO 1770
C J = JUSTIFY JT=JUSTIFY TEXT
IF(I1.EQ.LGG)GO TO 2220
C G = GET, GM=GET MORE
IF(I1.EQ.LWW)GO TO 850
C W = WEDGE ACCENT
IF(I1.EQ.'(')GO TO 1430
IF(I1.EQ.')')GO TO 1450
C LEFT AND RIGHT PARENTHESES
IF(I1.NE.LBB)GO TO 260
C******* ADD MORE LETTER ITEMS HERE *************
C B = BRC=BRACE, BRK=BRACKET -- FOR FRONT OF LINE. BAR=BAR LINE.
IF(X22.NE.0)GO TO 260
CRR*** REREAD 2430,JA,JA,JA,R2,RJQ
CRR*** J=4
JA=4
R7=5
IF(I3.NE.LCC)R7=4
IF(I3.EQ.LRR)R7=0
GO TO 900
350 IF(I2.EQ.LDD)GO TO 570
C 'A' = ALTER(GO TO 112) ADJUST(GO TO 886) ACCEL(GO TO 7813)
C ALIGN=GO TO 886
IF(X22.NE.0)GO TO 580
IF(I2.EQ.LTT)GO TO 1410
C AT=A TEMPO
IF(I2.EQ.LRR)GO TO 1420
C AR=ARCO
IF(I2.NE.LCC)GO TO 1060
IF(I3.EQ.LTT)GO TO 810
C ACT=ACCENT. NEXT FOR AC (=ACCEL.)
RD=80
GO TO 880
360 IF(I2.GE.IBLA)GO TO 650
C 'D' DIM →578, DOWN →883, DELETE →112 OR 883 DP →886
IF(I2.NE.LEE)GO TO 370
IF(X22.NE.0)GO TO 650
GO TO 1060
370 IF(I2.EQ.LPP)GO TO 570
IF(I2.NE.LII)GO TO 260
C NEXT FOR DIM.=82
IF(X22.NE.0)GO TO 260
RD=82
GO TO 880
380 I1=LEL
390 FSCN=I1
GO TO 330
400 I1=LRR
GO TO 390
410 I1=LUU
GO TO 390
420 I1=LDD
GO TO 390
430 I1=IXX
GO TO 180
440 I1=LCC
GO TO 180
450 I1=FSCN
IF(FSCN.EQ.LEL)GO TO 460
IF(FSCN.EQ.LRR)GO TO 460
C NEXT FOR UP-DOWN
UD=UD/2
GO TO 330
460 RL=RL/2
GO TO 330
470 I1=FSCN
IF(I1.EQ.LEL)GO TO 480
IF(I1.EQ.LRR)GO TO 480
UD=UD*2
GO TO 330
480 RL=RL*2
GO TO 330
C 'S'=SET, SA=SAVE, SB=SAVE BIG, SM=BIG+SAME NAME, ST=STAFF, SP=SPC STF
C SC=SPACING SCALE ABOVE STAFF n (99=DELETE IT)
490 IF(I2.EQ.LTT)GO TO 560
IF(I2.EQ.LAA)GO TO 520
IF(I2.EQ.LCC)GO TO 580
IF(I2.EQ.LDD)GO TO 520
IF(I2.EQ.LEE)GO TO 530
IF(I2.EQ.IBLA)GO TO 530
IF(I2.EQ.LPP)GO TO 730
IF(I2.EQ.LHH)JFONT=1
IF(I3.EQ.IXX)JFONT=0
IF(I3.EQ.LPP)JFONT=-1
IF(I3.EQ.LOH)JFONT=-2
IF(I3.EQ.LII)JFONT=-3
C 'SH'(=SHOW) IS SAME AS 44 1. SHOWS TYPE FONTS ON DPY.
C 'SHP' = SHOW ONLY AS 'PRIMITIVE' FONT, 'SHX' = CANCEL FONTS ON DPY.
C 'SHO' = FONT SET (TEMPORARILY) TO 'BDR'; 'SHI' = 'BDI' (ITALICS)
IF(I2.NE.LFF)GO TO 510
RD=45
IF(I3.NE.LZZ)GO TO 880
RD=92
CRR***500 REREAD 2430,JA,JA,JA,R2,RJQ
500 R5=RD
GO TO 890
510 IF(I2.NE.LMM)GO TO 130
C ONLY FOR ST, SA, SB, SM, RS, S, SF=45, SFZ=92
520 IF(X22.NE.0)GO TO 130
SAVER=4
CALL SAVIT
GO TO 130
530 JA=55
R2=RN(MEDIT+3)
C POSITION OF ITEM LOOKED AT.
R3=55.
GO TO 1110
C ABOVE FOR 'S'ET ALIGNMENT
C 'S'=SET ALIGNMENT, 'A'=ALIGN IT. 'M'=MOVER 'C'= COPIER
C 'E'=EDIT; 'I'=ITEM; 'G'=GET; 'GM'=GET MORE;
540 K=-1
DO 550 JA=3,10
550 IF(INP(JA).NE.IBLA)GO TO 570
GO TO 650
CRR***560 FORMAT(A2,21F)
CC IF(X22.NE.0)GO TO 59
560 IF(I3.EQ.LCC)GO TO 830
C STC=STACCATO
570 IF(CHNG.NE.0)GO TO 130
C CAN'T DO 'ST' AND OTHER THINGS AFTER CHANGES IN EDIT MODE.
CRR***580 REREAD 560,K,R2,RJQ
580 JA=55
IF(I2.NE.LCC)GO TO 590
CALL SCL
GO TO 130
590 IF(I2.NE.LDD)GO TO 600
IF(I1.EQ.LAA)JA=190
C 'AD'just stems to beams. 'A'=ADJUST LFT-RT POS. AFTER 'SET' COMMAND
600 IF(I2.EQ.LTT)JA=44
IF(I2.EQ.LNN)GO TO 950
IF(I2.NE.LPP)GO TO 1110
IF(DISAPR(DP).EQ.0)GO TO 120
GO TO 1320
C 'LP'=LIGHT PEN. TO BE USED ONLY IN EDIT MODE
640 IF(X22.EQ.0)GO TO 260
C 'X' GO BACK IF NOT IN EDIT MODE -- ALSO R,L,U,D
MINUZ=0
C CLEAR MINUS SIGN FLAG
C NEXT FOR READ, RS, DEL, L,R,U,D
650 IF(IX.EQ.I)GO TO 670
C CAN'T DELETE ('DE') AFTER A PARAM HAS BEEN CHANGED. START OVER.
IF(I2.NE.LEE)GO TO 680
GO TO 130
C R = RIGHT MOVE, RI=RIT., RS=RESTART, READ=READ
660 IF(I2.GE.IBLA)GO TO 680
IF(I2.EQ.LEE)GO TO 200
C ABOVE FOR 'READ'(SAME AS 'FILE')
IF(X22.NE.0)GO TO 260
C GO BACK IF STILL IN EDIT MODE.
IF(I2.EQ.LSS)GO TO 10
C TYPE 'RS' TO RESTART.
CCCC IF(I2.EQ.LEE)GO TO 200
C ABOVE FOR 'READ'(SAME AS 'FILE') NEXT FOR RIT.=37
RD=37
GO TO 880
670 IF(I1.EQ.LCC)GO TO 1650
680 IF(I1.EQ.LEE)GO TO 690
C ABOVE FOR 'ED' (WITH LIGHT PEN)
IF(X22.EQ.0)GO TO 130
C CAN'T MOVE ITEMS UNLESS REALLY IN EDIT MODE!
IF(QUICK.EQ.0.AND.I2.NE.LEE)QUICK=2
C NOW PARAMS DON'T PRINT OUT WHEN USING L,R,U,D***(BUT DE=DELETE)
690 CALL EDIT(JJA)
IF(JA.NE.99)GO TO 1110
CALL DELETE
C DELETE ROUTINE COULD BE PUT DIRECTLY IN HERE.
GO TO 1700
700 FORMAT(72A1)
C TYPE L, R, U OR D OR EDIT TO MOVE LAST ENTERED ITEM.
710 IF(I2.NE.IXX.AND.I2.NE.LBB)GO TO 715
C TYPE 'NX' TO RESTART WITH NEXT ALPHABETICAL FILE NAME (ONLY 5TH LETTER THOUGH.)
C 'NB' BACKS UP ONE FILE
IF(X22.NE.0)GO TO 130
C DON'T GO TO NEXT IF IN EDIT MODE
I1=LRR
I4=PLUS
IF(I2.EQ.LBB)I4=MINUS
I2=LSS
C I4 IS USUALLY NAME INPUT FILE
GO TO 10
715 IF(QUICK.NE.0)GO TO 720
C ↑↑↑ SO 'N n' WILL WORK EVEN AFTER N HAS BEEN SET.
QUICK=1
C TYPE 'N' =NO-TYPE PARAMS TO SUPPRESS TYPE-OUT WHILE EDITING.
IF(X22.NE.0)GO TO 730
720 I1=LII
C 'N n' WHEN NOT IN EDIT MODE = 'I n'<CR>,'N'<CR>
730 IF(I1.NE.LII)GO TO 750
740 IF(I2.EQ.LNN)GO TO 570
C 'IN n,n,n,' MUST BE READ AGAIN AT 886 TO GET n'S CORRECTLY.
JA=223
C JA=223 FOR EDIT MODE
IF(CHNG.NE.0)GO TO 130
C AFTER A CHANGE OF AN ITEM, 'I', ETC. IS ILLEGAL.
IF(R2.EQ.0)GO TO 1110
IF(R2.LT.1.0)GO TO 130
C CATCHES TYPOS. (I.E. DECI. NUMBER AFTER I)
GO TO 1110
750 IF(K)JA=55
C ED 47 -1 = 55 47 -1, ETC.
IF(JA.EQ.101)GO TO 590
IF(I1.NE.LNN)GO TO 760
IF(R2.NE.0)GO TO 720
C IF NO NUM FOLLOWS 'N' GO PRINT OUT CURRENT PARAMS.
GO TO 290
C 'Z' = ZOOM (OLD CODE# 24)
760 IF(I2.NE.LPP)GO TO 770
CRR*** RSET4=R3
RSET4=R2
C SPn SETS "SETUP" STAFF NUMBER
GO TO 130
C 'SP' IS SAME AS 444
C 'P n' = PRINT CURRENT CONTENTS OF PARAM n. (ONLY WHILE IN EDIT MODE.)
770 IF(X22.EQ.0.OR.I2.EQ.LEL)GO TO 910
C JUMP OUT IF 'TL' (TYPLOC)
QUICK=0
C TYPE 'T' TO RESET PARAM TYPE-OUT
IF(R2.EQ.0)GO TO 130
GO TO 720
780 RD=14
C PLUS
CRR***790 REREAD 560,JA,R2,RJQ
CRR790 CONTINUE
800 IF(X22.NE.0)GO TO 130
C CAN'T ENTER NEW ITEM WHILE IN EDIT MODE.
CRR*** J=9
JA=9
R5=RD
IF(R4.EQ.0)R4=15
GO TO 900
810 RD=5
C ACCENT
CRR***820 REREAD 2430,J,J,J,R2,RJQ
CRR820 GO TO 800
GO TO 800
830 RD=7
C STACC.
CRR*** GO TO 820
GO TO 800
840 IF(I3.EQ.LEL)GO TO 200
C JUMP FOR HELP
IF(X22.NE.0)GO TO 260
C CAN'T DO NEXT IF STILL IN EDIT MODE.
RD=13
C HARMONIC
IF(I2.EQ.LWW)RD=21
C HEAVY WEDGE
CRR*** GO TO 790
GO TO 800
850 RD=4
C WEDGE
CRR*** GO TO 790
GO TO 800
CRR***860 REREAD 560,JA,R2,RJQ
860 R5=26
CRR*** J=9
JA=9
IF(R4.EQ.0)R4=12
C FERMATA
GO TO 900
870 IF(I2.EQ.LII)GO TO 200
IF(X22.NE.0)GO TO 260
R5=51
C F=51 FF=52 FFF=53, FE=FERMATA, FILE
IF(I2.EQ.IBLA)GO TO 890
IF(I2.EQ.LEE)GO TO 860
RD=53
IF(I3.NE.IBLA)GO TO 500
RD=52
CRR***880 REREAD 560,JA,R2,RJQ
880 R5=RD
CRR***890 J=3
890 JA=3
IF(R4.EQ.0)R4=-5
C ABOVE IS FOR DIRECT TYPING OF P,PP,PPP,MP,RIT., ETC.
C IF PARAM 4 IS 0, PUTS IT -5 BELOW.
CRR***900 JA=J
900 IF(JA.GT.0)SAVER=SAVER-1
IF(SAVER.LT.0.AND.CHNG.LT.0)CALL SAVIT
C SAVES EVERY 5TH TIME AROUND (IF NO HANGING CHANGES IN DATA)
IF(QUICK.EQ.2)QUICK=0
C RESET QUICK(SUPRESSES PARAM PRINTOUT) IF CRLF AFTER L,R,U,D
IF(X22.NE.0)GO TO 1110
IOLD=0
C RESET FLAG FOR "I" COMMAND
IF(JA.EQ.0)GO TO 130
C CATCHES ZEROS
GO TO 1110
C NEXT FOR ALPHA TEXT ITEMS. 'T'=TYPE
910 IF(I2.NE.LEE)GO TO 920
RD=9
C TENUTO
CRR*** GO TO 790
GO TO 800
920 IF(I2.NE.LEL)GO TO 940
CRR*** J3=R3
CRR*** J4=R4
J3=R2
J4=R3
C 'TL' SET LOCATION OF TYPE OUT ON SCREEN
IF(J4.EQ.0)J4=J3-200
C OMIT 2ND NUM. AND GET N AND N-200.
CRR*** IF(R3.NE.0)GO TO 930
CRR*** IF(R4.NE.0)GO TO 930
IF(R2.NE.0)GO TO 930
IF(R3.NE.0)GO TO 930
J4=0
J3=450
C 'TL' 0 0 PUTS IT BACK TO ORIG. LOC.
930 CALL TYPLOC(J3,J4)
GO TO 130
940 JA=16
C ????'T' = TEST INPUT
J2=R2
M=I
CALL WORDS
SAVER=SAVER-1
IOLD=0
GO TO 1340
950 IF(X22.NE.0)GO TO 130
JA=140
RMODE2=R3
C ????? CHECK THIS TYPE 'IN STF# MODE' ETC. -- SAME AS 140 STF#.
960 SCORE=0
IF(JA.NE.140)GO TO 990
C NEXT PUTS UP STAFF IF IT WASN'T THERE ALREADY
SAVER=-1
RSTF=R2
C DO I NEED THE NEXT???
IF(R3.LT.0)R3=0
DO 970 K=1,ITEM
J=PWDS(K)
IF(RN(J+1).NE.8)GO TO 970
IF(RN(J+2).EQ.R2)GO TO 980
970 CONTINUE
C DIDN'T FIND THIS STAFF
M=LIMIT
C ↑↑ WAS =2000 6/78
IGO=0
JA=8
R3=0
GO TO 1110
980 JA=140
ITCHK=ITEM
ICHK=I
IDPY=ST2
C ALL THIS FOR BACKUPS
990 SPD=ST2
JIT=ITEM
ISC=I
REND=0
C RETAINS ORIGINS OF SCORE SQUENCE
1000 IF(REND.EQ.2)GO TO 990
C FOR READIN CONTINUATION.
M=ISC
1010 IF(JA.EQ.8)GO TO 980
IF(INSCOR(SCORE).EQ.0)GO TO 1340
GO TO 130
1060 IGO=1
CALL GRED
JFONT=0
IF(JA.EQ.98)GO TO 1080
IF(I2.NE.LDD)GO TO 1065
C FOR 'CD' CENTER DASHES
JJ2=1
GO TO 1785
1065 KNT=0
SCORE=0
1070 KNT=KNT+1
C NUM OF ITEMS IN LIST
R11=0
R10=0
R9=0
JA=R(1,KNT)
R2=R(2,KNT)
IF(JA.NE.0)GO TO 1090
C =0 MEANS NO MORE ITEMS.
CC CALL DPYOUT(1)
CALL DPYDO(1)
GO TO 40
1080 X22=0
IGO=-1
CALL DPYNEW
GO TO 120
1090 DO 1100 K=1,6
1100 RJQ(K)=R(K+2,KNT)
1110 M=1
EDQ=-1
IF(JA.EQ.222)GO TO 1650
IF(JA.EQ.2222)GO TO 1670
DO 1120 K=1,20
1120 JQ(K)=RJQ(K)
C X22= ITEM# WHEN EDITING OR DELETING.
IF(X22.NE.0)GO TO 1610
IF(JA.GT.0)GO TO 1130
IF(R2.EQ.0)GO TO 130
C FOR UP, DOWN, LEFT, RIGHT
RJJ2=J2
GO TO 1850
C GOES BACK IF NEGATIVE AND NOT IN EDIT MODE.
1130 IF(JA.EQ.223)GO TO 1500
IF(JA.EQ.44)GO TO 1510
C THIS '44' IS SET IN 'EDIT' - IT'S NEVER TYPED.
IF(JA.EQ.55)GO TO 1480
IF(JA.NE.190)GO TO 1860
CC1140 CALL HOMER
1140 CALL HOMX
C GO ADJUST STEM LENGTHS
GO TO 1790
1150 IF(X22.EQ.0)GO TO 1350
C WHEN NOT IN EDIT MODE(X22=0) "P n n2" LISTS ALL PARAMS FOR ITEMS n→n2
J2=R2
TYPE 1160,J2,RJJ(J2-2)
C TYPE P n TO SEE FULL CONTENTS OF PARAM. n.
GO TO 130
1160 FORMAT(I,F15.5)
1170 IF(X22.NE.0)GO TO 260
CALL ZOOM
1320 M=1
I=PWDS(ITEM+1)
ITEMX=ITEM
C FOR USE IN CENTERING WHOLE RESTS (IN NOTWRT [NTSM.FAI])
ITEM=0
1330 ST2=3
1340 PLT=1
EDQ=0
CALL ACCPOG(1)
IF(JA.EQ.0)GO TO 2370
IF(JA.NE.24)IGO=0
GO TO 2370
1350 IF(I2.EQ.LRR)GO TO 1360
C NOW TYPE 'PR' TO PRINT PARAMETER LIST
IF(I2.EQ.LZZ)GO TO 1370
C PIZZ
R5=42
IF(I2.EQ.IBLA)GO TO 890
IF(I2.EQ.LPP)RD=41
C PPP=40 PP=41 P=42 POCO=72 PIU=91
IF(I2.EQ.LII)RD=91
IF(I2.EQ.LOH)RD=72
IF(I2.EQ.LEL)GO TO 780
C PLUS
IF(I3.EQ.IBLA)GO TO 880
RD=40
GO TO 500
1360 CALL LISTP(LST)
GO TO 130
1370 RA=51857895.
RB=95389999.
C PIZZ.
1380 RD=0
1390 RE=1
CRR***1400 J=16
1400 JA=16
CRR*** REREAD 560,JA,R2,RJQ
R6=RA
R7=RB
R8=RD
IF(R5.EQ.0)R5= RE
IF(R4.EQ.0)R4=14
C 0=PUT IT ABOVE STAFF
GO TO 900
1410 RA=51704789.
RB=74828584.
RD=99999999.
C A TEMPO
GO TO 1390
1420 RA=51708772.
RB=84999999.
C ARCO
GO TO 1380
1430 RA=40999999.
1440 RB=0
GO TO 1380
C LEFT AND RIGHT PARENTHESES AND COMMA
1450 RA=41999999.
GO TO 1440
1460 RA=36999999.
RB=0
RD=0
RE=1.5
C COMMA IS DEFAULT SIZE 1.5
GO TO 1400
1470 CALL JUGGLE
CALL CLRCUR
CALL DPYNEW
CHNG=0
C RESET CHANGE FLAG - CLEAR EDIT MODE ERROR TRAP
IF(JA.EQ.223)GO TO 1690
C FOR MOVING DIRECTLY TO NEW ITEM IN EDIT MODE.
IF(ZERO)GO TO 120
X22=ZERO
ZERO=-1
IF(JA.EQ.55)GO TO 1480
IF(JA.EQ.44)GO TO 1510
IF(KED.NE.0)GO TO 1530
GO TO 1700
C 55,POS -- SETS UP ALIGNMENT
1480 CALL ESPOS(RLINE)
GO TO 1520
C '223,0' EDITS LAST ITEM ENTERED
1500 REDIT=999.0
IF(R2.NE.0)GO TO 1550
X22=ITEM
IF(IOLD.EQ.0)GO TO 1710
IF(IOLD.LE.ITEM)X22=IOLD
GO TO 1710
1510 KED=1
RITEM=R3
C 'ST*, STF#, CODE# (IF 0, ALL ITEMS COME UP) - STF>7 = ALL STAVES.
IF(R2.GT.7)KED=2
1520 REDIT=R2
C THE STAFF #
JED=1
1530 IF(EDX(RLINE).GE.0)GO TO 1670
GO TO 1710
C CR MOVES ALONG GIVEN LINE, 222 LEAVES THIS MODE
1540 CALL ACCPOG(1)
IF(I.EQ.IX)ITEM=ITEM-1
GO TO 1560
1550 IF(X22.GT.0)GO TO 1610
1560 IF(R2.NE.0)GO TO 1690
IF(JA.NE.0)MINUZ=0
IF(REDIT.EQ.999)GO TO 1570
IF(JA.GT.0)GO TO 1530
1570 IF(JA.GE.0)GO TO 1580
X22=X22+JA
C FOR TYPING '-n'
GO TO 1600
1580 IF(I1.EQ.PLUS)MINUZ=0
IF(I1.EQ.MINUS)MINUZ=-1
C TYPE '-' WITH NO NUM. TO BACKUP WITH CRLF ONLY
C TYPE '+' TO GO FORWARD
IF(MINUZ.LT.0)GO TO 1590
IF(REDIT.NE.999.)GO TO 1530
C JUMP IF IN 'ED' OR 'ST' MODES
X22=X22+1
GO TO 1700
1590 X22=X22-1
1600 IF(X22.LT.1)GO TO 1670
C EXIT FROM EDIT MODE IF GONE OFF BOTTOM
GO TO 1700
C FOR EDITING
1610 IF(JA.EQ.55)GO TO 1800
1620 IF(JA.NE.223)GO TO 1630
C 'I, #' WILL MOVE TO ANOTHER ITEM WHEN ALREADY IN EDIT MODE.
KED=0
JED=0
GO TO 1650
1630 IF(JA.EQ.44)GO TO 1800
C FOR '24' WHILE IN EDIT MODE. MAGS WITH CURSOR AS CENTER.
IF(JA.GT.100)GO TO 1640
IF(JA.GT.13)GO TO 130
C PARAM NUM TOO HIGH? LOOKS FOR NEXT ITEM TO EDIT IF <CR>
1640 IF(X22.EQ.0)GO TO 1720
IF(R2.NE.0)GO TO 1720
C BACKS UP WHEN IN EDIT MODE.
IF(JA.GT.0)GO TO 1730
IF(I.EQ.IX)GO TO 1540
IF(CHNG.NE.0.AND.JA.LT.0)GO TO 130
C CAN'T DO '-N' AND OTHER THINGS AFTER CHANGES IN EDIT MODE.
ZERO=X22+1
C '0' AFTER AN EDIT ENDS THE EDIT AND GETS NEXT ITEM FOR EDIT.
1650 IF(X22.EQ.0)GO TO 120
IF(KED.EQ.0)REDIT=999.
1660 IF(I.NE.IX)GO TO 1470
ITEM=ITEM-1
C TO DELETE AN ITEM
1670 X22=0
MINUZ=0
C MINUS SIGN FLAG (WHEN -1, CRLF=BACKUP)
CHNG=0
C RESET CHANGE FLAG
CALL CLRCUR
CALL DPYNEW
IF(REDIT.EQ.999.)GO TO 1680
IF(JA.EQ.55)GO TO 1480
IF(JA.EQ.44)GO TO 1510
1680 IF(R2.EQ.0.OR.R2.GT.ITEM)GO TO 120
C DELETION IN EDIT MODE DOES NOT LEAVE MODE.
1690 X22=R2
1700 IF(X22.GT.ITEM)GO TO 1670
C LEAVES EDIT MODE.
1710 CALL BOXX
GO TO 120
1720 IF(JA.EQ.0)GO TO 1850
1730 X=100-JA
IF(X)JA=JA/100
IF(JA.LE.2)GO TO 1820
CALL EQUAL(X)
GO TO 1840
1740 IF(X22.EQ.0)GO TO 1770
C 'C' = COPY (IN OR OUT OF EDIT MODE) CR=CRESC.
CC IF(I2.EQ.IBLA)GO TO 883
IF(I2.NE.IBLA)GO TO 1760
1750 IF(CHNG.EQ.0)GO TO 130
C CAN'T 'COPY' UNLESS CHANGES WERE MADE.
IOLD=0
GO TO 650
1760 IF(I2.EQ.LPP)GO TO 1761
C CP n =CENTER BY NOTE POSITION ***** A BUG WITH CP WHEN USING 'READ'?????
IF(R2.NE.0)GO TO 1750
CALL EDCEN(CB)
GO TO 1110
1761 CALL SETLET
GO TO 1110
1770 IF(I2.EQ.IBLA)GO TO 1780
IF(I2.EQ.LDD)GO TO 1060
C NOW 'CD', WHEN NOT IN EDIT MODE = CENTER ALL DASHES ON A LINE. (USES GRED)
RD=43
C NEXT FOR ME=MENO=81 MOLTO=90 CRESC.=70 MP=43 MF=50, ALSO 'MACRO'
IF(I2.EQ.LAA)GO TO 2400
IF(I2.EQ.LFF)RD=50
IF(I2.EQ.LOH)RD=90
IF(I2.EQ.LEE)RD=81
IF(I2.EQ.LRR)RD=70
IF(I2.NE.LTT)GO TO 880
C JT=JUSTIFY TEXT (ONLY 1 STAFF AT A TIME)
1780 CALL MOVER
IF(R2.GE.99)GO TO 260
C 99(+)=BACKUP OUT OF MOVER ETC.
JFONT=0
1785 IGO=0
C SO IT WON'T DO ALL FONT LOOKUPS.
1790 IF(JJ2)GO TO 130
M=PWDS(JJ2)
I=PWDS(ITEM+1)
ITEM=JJ2-1
ST2=WDS(JJ2)
C SO IT DOESN'T HAVE TO GO THROUGH ALL ITEMS
GO TO 1340
1800 IF(REDIT.NE.55.)REDIT=0
C NEEDED FOR 'S'ET, THEN 'A'LIGNE ROUTINE
IF(I2.NE.IBLA)GO TO 1660
C WE GET HERE WHEN TYPING 'ST' OR 'ED' WHEN ALREADY IN EDIT MODE.
IF(R2.EQ.0)GO TO 1810
IF(CHNG.NE.0)GO TO 130
C CATCH 'S'ET AFTER A CHANGE WAS MADE.
GO TO 1660
C GO PAST HERE ONLY FOR 'A'LIGN
1810 IF(KED.GE.0)RLINE=RJ3
RJ3=RLINE
GO TO 1840
C FOR '55' ALIGNING
1820 IF(X)GO TO 1830
CALL PARCH(JA,JJA,R2)
GO TO 1840
1830 RJJ2=R2+RJJ2
C ARRAYS NEED 2O LOCATIONS HERE.
C CHNG PARAMS WITH PAIRS OF NUMS.(EG. 2,122 4,13 5,-2 ETC.)
1840 CALL RJED
1850 CALL RJED2
ST2=WDS(ITEM+1)
I=PWDS(ITEM+1)
IF(X22.NE.0)CHNG=-1
C SET CHANGE FLAG TO TRAP EDIT MODE ERRORS. (CLEARED AT 172)
CALL DPYNEW
1860 J2=R2
IF(J2.LT.0)GO TO 130
IF(J2.GT.7)GO TO 130
C STOPS TYPO ERROR ON STAFF NUM. (<0, >7)
RSTJ2=RSTFAC(J2)
1870 IF(JA.EQ.16)GO TO 1910
IF(PLT.NE.0)GO TO 2080
IF(JA.NE.2)GO TO 1880
IF(R8.NE.0)GO TO 2010
IF(R9.NE.0)R9=0
GO TO 2010
1880 IF(JA.NE.8)GO TO 1900
IF(R9.NE.1)GO TO 2010
L=7
K='INST.'
C RJQ(7) IS R9
1890 RA=RN(MEDIT+L+2)
CALL TYPCHR(RA,5)
CALL TYPCRL
CALL TYPSTR('TYPE ')
CALL TYPCHR(K,5)
CALL TYPSTR(' NAME ')
READ(IDEV,FA5)RD
CALL LO2UP(RD)
RJQ(L)=RD
IF(RD.NE.' ')GO TO 2010
IF(RN(MEDIT).LT.L)RA=0
C RESTORES NAME IF THERE WAS ONE ALREADY. ELSE=0
RJQ(L)=RA
C WHEN P9=1 ASKS FOR ID NAME FOR THE STAFF (FOR PART EXTRACTOR)
GO TO 2010
CF371 FORMAT(A5,A1,A3)
1900 IF(JA.NE.11)GO TO 2010
C ↑↑↑↑ WAS - TO 63
IF(J10.NE.1)GO TO 2010
K='FILE'
L=8
C P10←1 GETS NAME OF BASIC DRAW FILE, PUTS IT IN P10 (NJR)
GO TO 1890
C IF NO NAME ASKED FOR, IT TAKES LAST NAME GIVEN.(SOLVES SORT PROB?)
1910 RD=R5
IF(RD.GE.100)RD=RD-100
C ADD 100 TO SZ TO MAKE TEXT APPEAR IN ALL SEPARATE PARTS OF ORCH. SCORE
IF(J10.EQ.0)GO TO 2000
L=ITEM
IF(X22.NE.0)L=X22-1
IF(J10.EQ.1)GO TO 1980
C TEMP. FIX TO CNVT TEXT FORMAT TO NEW STYLE. "10 99"
C NEXT FOR CENTERING TEXT. P10>1
1950 CALL CENTXT(RD)
GO TO 2000
1980 CALL CONTXT
C FOR TEXT CONTINUATION
2000 IF(PLT.NE.0)GO TO 2080
2010 CALL MORCEN(CB)
C **** FOR '0' EDITS ******
2070 CALL LUP2
2080 IF(DP(J2).GE.0)GO TO 2090
IF(JA.NE.8)GO TO 70
C NOW GET SIZE FACTOR, IF IT'S THERE. (NEEDED IN 'SCORE' SECTION.)
IF(R5.NE.0)RSTFAC(J2)=R5
GO TO 70
C*** 3/74 NEW DP SYSTEM
C WHAT ABOUT EDITS?*******
2090 POS=STFF(J2)
RX3=R3
C SAVES IT IN RJQ(20) FOR OTHER ROUTINES.
J3=ROFF(RHORZ(R3))
C LINE IS DIVIDED INTO 200 POINTS.
CALL CENTX
C SETS VERT.(CENTR) POSITION BASED ON STAFF AND R4
R3=J3
IF(JA.LE.2)GO TO 60
2100 GO TO(2430,2430,2130,2210,2140, 2190,2150,2180,60,2120, 2130,2200)
1,JA
GO TO (2150,2160,2170),JA-15
C FOR 16,17,18 (WORDS, KSIG, METER)
IF(JA.EQ.99)GO TO 70
C FOR PART EXTRACTOR TRANSPOSER - KEY SIG=0
IF(JA.NE.33.AND.JA.NE.44)GO TO 2110
JA=JA/11
C THIS IS TEMPORARY - TO READ PAGE TEMP. FILES.
GO TO 2100
2110 I=PWDS(ITEM+1)
GO TO 130
C 44 1; JFONT=ONE DISPLAYS FONTS - THIS ALSO CATCHES SOME TYPOS
2120 CALL MAKNUM(R5)
GO TO 70
2130 CALL CLEFS
GO TO 70
2140 CALL SLUR
GO TO 70
2150 CALL ALPHA
GO TO 70
2160 CALL KSIG
GO TO 70
2170 CALL METER
GO TO 70
2180 IF(R2.EQ.0)RMOV=R8
CALL STAFF
GO TO 70
CC625 IF(J10.LT.100)GO TO 1625
CC CALL BEAMX
CC GO TO 160
2190 CALL BEAMX
CC625 CALL BMSTF
GO TO 70
C BEAMS, STAFF LINES ****
2200 CALL CIRCLE
GO TO 70
2210 CALL ITMSUB
C BAR LINES, ETC.
GO TO 70
2220 K=0
C GETS SAVED MS FILES
GO TO 2230
2250 K=-1
C -1=FILE NAME ALREADY GIVEN
2230 CALL GETMS(K)
GO TO(2110,130,1320,240)K
C K IS RESET IN GETMS
C NEXT RUNS THROUGH DATA WITH NEW CHANGES.
2370 IF(M.GE.I)GO TO 2390
IF(IGO.EQ.0)GO TO 2380
C USE "Z" TO DO FIXUP WHEN LIST IS SCRAMBLED !?X@!ZQ
IF(M.EQ.PWDS(ITEM+1))GO TO 2380
K=ITEM+1
CALL TYPSTR(' FIXING ITEM ')
CALL TYPINT(K)
CALL TYPCRL
PWDS(K)=M
2380 CALL RUNTHR(M)
IF(EDQ.LE.0)GO TO 1860
GO TO 130
2390 M=1
IF(PLT.EQ.1)EDQ=-1
PLT=0
GO TO 130
C ALWAYS START PLOT WITH BOTTOM UNIT ON PAGE AND WORK UP.
2400 CALL TYPSTR(' MACRO FILE NAME= ')
ACCEPT 190,K
IF(K.EQ.'99')GO TO 130
C TYPE 99 TO BACKUP.
CALL LO2UP(K)
IF(K.EQ.IBLA)K='MACRO'
CALL OFILE(1,K)
CALL TYPSTR(' END MACRO WITH * ')
CALL TYPCRL
2410 ACCEPT 700,INP
IF(I1.EQ.ISTAR)GO TO 2420
WRITE(1,700)INP
GO TO 2410
2420 END FILE 1
CALL TYPSTR(' MACRO=')
CALL TYPWRD(K)
CALL TYPSTR('.DAT ***** RUN IT? ')
ACCEPT 700,I1
CALL LO2UP(I1)
IF(I1.EQ.LYY)GO TO 220
GO TO 130
CRR***2430 FORMAT(I,24F)
2430 END